beadando
2024-12-04
Beadandó
Az adattudomány statisztikai alapjai tárgy, 2024/25/1 félév 2024.12.04 Gellén Rebeka
Adat beolvasása
Olyan adatbázissal dolgozunk, ahol Spotify-on megtalálható zenék adatai szerepelnek.
data <- read.csv("spotify.csv")
head(data)## track_id track_name
## 1 6f807x0ima9a1j3VPbc7VN I Don't Care (with Justin Bieber) - Loud Luxury Remix
## 2 0r7CVbZTWZgbTCYdfa2P31 Memories - Dillon Francis Remix
## 3 1z1Hg7Vb0AhHDiEmnDE79l All the Time - Don Diablo Remix
## 4 75FpbthrwQmzHlBJLuGdC7 Call You Mine - Keanu Silva Remix
## 5 1e8PAfcKUYoKkxPhrHqw4x Someone You Loved - Future Humans Remix
## 6 7fvUMiyapMsRRxr07cU8Ef Beautiful People (feat. Khalid) - Jack Wins Remix
## track_artist track_popularity track_album_id
## 1 Ed Sheeran 66 2oCs0DGTsRO98Gh5ZSl2Cx
## 2 Maroon 5 67 63rPSO264uRjW1X5E6cWv6
## 3 Zara Larsson 70 1HoSmj2eLcsrR0vE9gThr4
## 4 The Chainsmokers 60 1nqYsOef1yKKuGOVchbsk6
## 5 Lewis Capaldi 69 7m7vv9wlQ4i0LFuJiE2zsQ
## 6 Ed Sheeran 67 2yiy9cd2QktrNvWC2EUi0k
## track_album_name
## 1 I Don't Care (with Justin Bieber) [Loud Luxury Remix]
## 2 Memories (Dillon Francis Remix)
## 3 All the Time (Don Diablo Remix)
## 4 Call You Mine - The Remixes
## 5 Someone You Loved (Future Humans Remix)
## 6 Beautiful People (feat. Khalid) [Jack Wins Remix]
## track_album_release_date playlist_name playlist_id playlist_genre
## 1 2019-06-14 Pop Remix 37i9dQZF1DXcZDD7cfEKhW pop
## 2 2019-12-13 Pop Remix 37i9dQZF1DXcZDD7cfEKhW pop
## 3 2019-07-05 Pop Remix 37i9dQZF1DXcZDD7cfEKhW pop
## 4 2019-07-19 Pop Remix 37i9dQZF1DXcZDD7cfEKhW pop
## 5 2019-03-05 Pop Remix 37i9dQZF1DXcZDD7cfEKhW pop
## 6 2019-07-11 Pop Remix 37i9dQZF1DXcZDD7cfEKhW pop
## playlist_subgenre danceability energy key loudness mode speechiness
## 1 dance pop 0.748 0.916 6 -2.634 1 0.0583
## 2 dance pop 0.726 0.815 11 -4.969 1 0.0373
## 3 dance pop 0.675 0.931 1 -3.432 0 0.0742
## 4 dance pop 0.718 0.930 7 -3.778 1 0.1020
## 5 dance pop 0.650 0.833 1 -4.672 1 0.0359
## 6 dance pop 0.675 0.919 8 -5.385 1 0.1270
## acousticness instrumentalness liveness valence tempo duration_ms
## 1 0.1020 0.00e+00 0.0653 0.518 122.036 194754
## 2 0.0724 4.21e-03 0.3570 0.693 99.972 162600
## 3 0.0794 2.33e-05 0.1100 0.613 124.008 176616
## 4 0.0287 9.43e-06 0.2040 0.277 121.956 169093
## 5 0.0803 0.00e+00 0.0833 0.725 123.976 189052
## 6 0.0799 0.00e+00 0.1430 0.585 124.982 163049PCA
Numerikus oszlopok kiválasztása
num_data <- data[, c("danceability", "energy", "valence", "tempo", "loudness")]
head(num_data)## danceability energy valence tempo loudness
## 1 0.748 0.916 0.518 122.036 -2.634
## 2 0.726 0.815 0.693 99.972 -4.969
## 3 0.675 0.931 0.613 124.008 -3.432
## 4 0.718 0.930 0.277 121.956 -3.778
## 5 0.650 0.833 0.725 123.976 -4.672
## 6 0.675 0.919 0.585 124.982 -5.385pca_model <- prcomp(num_data, scale = TRUE)
summary(pca_model)## Importance of components:
## PC1 PC2 PC3 PC4 PC5
## Standard deviation 1.3205 1.1791 0.9602 0.8068 0.54137
## Proportion of Variance 0.3488 0.2781 0.1844 0.1302 0.05862
## Cumulative Proportion 0.3488 0.6268 0.8112 0.9414 1.00000pca_model$rotation## PC1 PC2 PC3 PC4 PC5
## danceability -0.04173127 0.697432291 0.06026072 -0.6860986 -0.19360798
## energy 0.68991962 -0.007942764 -0.12388735 0.1365999 -0.69995730
## valence 0.16156962 0.615509115 0.44429271 0.6009973 0.19091899
## tempo 0.22785514 -0.365926181 0.84478995 -0.3165530 0.01744149
## loudness 0.66651835 0.027778965 -0.26448914 -0.2218234 0.66016776Screeplot
screeplot(pca_model, main = "Screeplot", col = "pink")
# Biplot készítése
biplot(pca_model, main = "PCA Biplot", col = "pink")
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.4.2pca_data <- as.data.frame(pca_model$x)
ggplot(pca_data, aes(PC1, PC2)) +
geom_point() +
theme_minimal() +
labs(title = "PCA ábra", x = "Főkomponens 1", y = "Főkomponens 2")
Az ábra a főkomponens-analízis (PCA) eredményeit mutatja, ahol az első
két főkomponens (PC1 és PC2) a teljes változékonyság legnagyobb részét
magyarázza. Az adatpontok elhelyezkedése az eredeti változók közötti
mintázatok és különbségek vizualizálását segíti elő. Az első két
főkomponens szerint az adatok jelentős része hasonló mintázatot
követ.
MDS
# egy véletlenszerű minta az adatból
set.seed(123)
sample_data <- num_data[sample(nrow(num_data), 1000), ]
dist_matrix <- dist(sample_data)
mds_model <- cmdscale(dist_matrix, k = 2)MDS eredmények ábrázolása
mds_data <- as.data.frame(mds_model)
colnames(mds_data) <- c("MDS1", "MDS2")ggplot(mds_data, aes(MDS1, MDS2)) +
geom_point() +
theme_minimal() +
labs(title = "MDS ábra", x = "MDS1", y = "MDS2")
Az ábra jól mutatja, hogy a random választott 100 adatban többféle zenét
sikerült kiválasztani, így nem lehet egyértelmű csoportokat
elkülöníteni.
K-means klaszterezés és MDS
# Véletlenszerű minta választása az adatból
set.seed(123)
sample_data <- num_data[sample(nrow(num_data), 1000), ]MDS
# Távolsági mátrix kiszámítása a minta alapján
dist_matrix <- dist(sample_data)
# MDS futtatása
mds_model <- cmdscale(dist_matrix, k = 2)Klaszterezés
kmeans_model <- kmeans(sample_data, centers = 3)Klaszerezés és MDS egyesítése
mds_data <- as.data.frame(mds_model)
mds_data$cluster <- as.factor(kmeans_model$cluster)Vizualizáció
ggplot(mds_data, aes(V1, V2, color = cluster)) +
geom_point() +
theme_minimal() +
labs(title = "MDS és K-means Klaszterek", x = "MDS1", y = "MDS2")
Az adatok három jól elkülönülő csoportba rendeződnek. A klaszterek
szoros elhelyezkedése arra utal, hogy a hozzájuk tartozó zeneszámok
hasonló jellemzőkkel bírnak.
MSD 3D-ben
# Véletlenszerű minta (1000 adatpont) kiválasztása
set.seed(123)
sample_data <- num_data[sample(nrow(num_data), 1000), ]
# Távolságmátrix kiszámítása
dist_matrix <- dist(sample_data)
# MDS alkalmazása
mds_model <- cmdscale(dist_matrix, k = 3) # 3D MDSÁbrázolás
mds_data_3d <- as.data.frame(mds_model)
mds_data_3d$cluster <- as.factor(kmeans_model$cluster) # Klaszterek hozzárendelése3D ábra
library(plotly)## Warning: package 'plotly' was built under R version 4.4.2##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutplot_ly(mds_data_3d, x = ~V1, y = ~V2, z = ~V3, color = ~cluster, type = "scatter3d", mode = "markers") %>%
layout(title = "3D MDS és K-means Klaszterek",
scene = list(xaxis = list(title = 'MDS1'),
yaxis = list(title = 'MDS2'),
zaxis = list(title = 'MDS3')))